
Imports MSXML2
Imports System.Web
Imports System.Net
Imports System.IO
Imports System.Net.Mail

Public Module ipmonitor

    Public Const maxLogCount = 8192
    Public Const serverIP As String = "http://192.168.1.254/userRpm/StatusRpm.htm"
#If DEBUG Then
    Public Const intervalTime As Int32 = 1000
#Else
    Public Const intervalTime As Int32 = 60000
#End If
    Public Const mailSleepTime As Int32 = 60000
    Public Const ipStart As String = "0, ""00-19-E0-E7-E5-65"", """
    Public Const ipEnd As String = """"
    Public Const mailServer As String = "smtp.qq.com"

    Friend WithEvents tm As New Timer
    Friend lastIP As String = Nothing

    Public Structure mailStruct
        Public sendURL As String
        Public user As String
        Public password As String
        Public body As String
        Public xmlhttp As XMLHTTP
    End Structure

    Public Function longTime() As String
        Dim str As String = Now.ToLongDateString + ", " + Now.ToLongTimeString
        Return str
    End Function

    Public Sub main(ByVal args() As String)
        tm.Interval = intervalTime
        tm.Enabled = True
        tm_Tick(Nothing, Nothing)

        While True
            Application.DoEvents()
            If tm.Interval > 1000 Then
                System.Threading.Thread.Sleep(tm.Interval - 1000)
            Else
                System.Threading.Thread.Sleep(tm.Interval)
            End If
        End While
    End Sub

    Private Sub tm_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles tm.Tick
        Dim thisIP As String = Nothing
        Dim request As WebRequest = WebRequest.Create(serverIP)
        Dim response As HttpWebResponse = Nothing
        Dim responseStream As StreamReader = Nothing
        request.Credentials = New NetworkCredential("admin", "shdansow")
        response = request.GetResponse
        responseStream = New StreamReader(response.GetResponseStream)
        thisIP = responseStream.ReadToEnd()
        thisIP = thisIP.Substring(thisIP.IndexOf(ipStart) + ipStart.Length())
        thisIP = thisIP.Substring(0, thisIP.IndexOf(ipEnd))
        Console.WriteLine("check ip @" + longTime() + ", thisIP = " + thisIP)

        If thisIP <> "0.0.0.0" Then
            tm.Interval = intervalTime
            If Not lastIP Is Nothing AndAlso lastIP <> thisIP Then
                Console.WriteLine("found ip change @" + longTime() + ", will send mail to hzj_jie@hotmail.com")
                If Not sendsmtpmail(mailServer, _
                                    "99282018@qq.com", "hzj_jie@hotmail.com", "", "", "ip change alarm", thisIP, _
                                    "99282018", "shdansow") Then
                    Console.WriteLine("mail sending failed")
                End If
            End If
            lastIP = thisIP
        Else
            tm.Interval = 1000
            Console.WriteLine("found lost network @" + longTime() + ", waiting for route to get new ip")
        End If
    End Sub

    Public Function sendhttpmail(ByRef sendURL As String, _
                                ByRef from As String, ByRef name As String, ByRef [to] As String, ByRef subject As String, ByRef body As String, _
                                ByRef serverUser As String, ByRef serverPassword As String) _
                                As Boolean
        Dim quote As String = """"
        Dim now As DateTime = DateTime.Now
        Dim timeStamp As String = now.ToString("ddd, dd MMM yyyy hh:mm:ss")

        Dim postBody As String = Nothing
        postBody += "MAIL FROM:<" + from + ">" + ControlChars.Cr + ControlChars.Lf
        postBody += "RCPT TO:<" + [to] + ">" + ControlChars.Cr + ControlChars.Lf
        postBody += ControlChars.Cr + ControlChars.Lf
        postBody += "From: " + quote + name + quote + " <" + from + ">" + ControlChars.Cr + ControlChars.Lf
        postBody += "To: <" + [to] + ">" + ControlChars.Cr + ControlChars.Lf
        postBody += "Subject: " + subject + ControlChars.Cr + ControlChars.Lf
        postBody += "Date: " + timeStamp + " -0000" + ControlChars.Lf
        postBody += ControlChars.Cr + ControlChars.Lf
        postBody += body

        Dim mail As New mailStruct
        mail.sendURL = sendURL
        mail.body = postBody
        mail.user = serverUser
        mail.password = serverPassword
        mail.xmlhttp = New XMLHTTP
        Dim mailThread As New System.Threading.Thread(AddressOf sendhttpmailThread)
        mailThread.Start(mail)

        Dim i As Int32
        For i = 0 To 9
            System.Threading.Thread.Sleep(mailSleepTime / 10)
            If Not mailThread.IsAlive Then
                If mail.xmlhttp.status = 200 Then
                    Return True
                Else
                    Return False
                End If
            End If
        Next
        mailThread.Abort()
        Return False
    End Function

    Public Sub sendhttpmailThread(ByVal obj As Object)
        On Error Resume Next

        Dim mail As mailStruct = CType(obj, mailStruct)
        mail.xmlhttp.open("POST", mail.sendURL, False, mail.user, mail.password)
        'mail.xmlhttp.open("POST", mail.sendURL, False, Nothing, Nothing)
        mail.xmlhttp.setRequestHeader("Content-Type", "message/rfc821")
        mail.xmlhttp.send(mail.body)
    End Sub

    Public Function sendsmtpmail(ByRef smtpServer As String, _
                            ByRef from As String, ByRef [to] As String, ByRef cc As String, ByRef bcc As String, _
                            ByRef subject As String, ByRef body As String, _
                            ByRef serverUser As String, ByRef serverPassword As String) As Boolean
        smtpServer = smtpServer.ToLower
        Dim client As New SmtpClient(smtpServer)
        Dim mail As New MailMessage(from, [to])
        If serverUser <> "" OrElse serverPassword <> "" Then
            'Dim credential As New NetworkCredential(serverUser, serverPassword)
            'Dim credentials As New CredentialCache()
            'credentials.Add(smtpServer, 25, "basic", credential)
            'credentials.Add(smtpServer, 25, "digest", credential)
            'credentials.Add(smtpServer, 25, "kerberos", credential)
            'client.Credentials = credentials
            'client.UseDefaultCredentials = False
            client.Credentials = New NetworkCredential(serverUser, serverPassword)
        Else
            client.UseDefaultCredentials = True
        End If
        If Not cc Is Nothing AndAlso cc <> "" Then
            mail.CC.Add(cc)
        End If
        If Not bcc Is Nothing AndAlso bcc <> "" Then
            mail.Bcc.Add(bcc)
        End If
        mail.Subject = subject
        mail.Body = body
        client.Host = smtpServer
        client.Timeout = mailSleepTime

        Try
            client.Send(mail)
            Return True
        Catch ex As Exception
            Return False
        End Try
    End Function

End Module
